home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / B-Business / (c)b2.d64 / weight watcher.c (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  5KB  |  165 lines
  1. 1 CLR:POKE53272,21:POKE53280,1:POKE53281,1:CR$=CHR$(13):PRINT"[144]":REMC64 MODS 1983
  2. 2 REM WEIGHT WATCHER BY M. CRITCHFIELD & T. DWYER
  3. 3 REM FROM THE NOVEMBER 1979 ISSUE OF
  4. 4 REM 'KILOBAUD' MAGAZINE  PAGE 156-157
  5. 5 REM MODIFIED FOR THE PET BY
  6. 6 REM R. E. HUTCHINGS
  7. 9 REM INPUT ROUTINE USED WITH PERMISSION FROM CURSOR, BOX550, GOLETA, CA 93017
  8. 15 GOSUB3000
  9. 18 PRINT"[147]      WEIGHT WATCHER'S RECORD"
  10. 20 PRINT:PRINT"WEEK","WEIGHT","WT. LOSS"
  11. 30 S=0:D=0
  12. 35 REM-----CALC. & PRINT TABLE-----
  13. 40 READG
  14. 45 I=0
  15. 50 I=I+1
  16. 60 READ W
  17. 70 IFI=1THEN110
  18. 80 IFW<0THEN140
  19. 90 D=W1-W
  20. 100 S=S+D
  21. 110 PRINTI,W,D
  22. 120 W1=W
  23. 125 IFI=16THENGOTO8000
  24. 126 IFI=32THENGOTO8000
  25. 127 IFI=48THENGOTO8000
  26. 128 IFI=64THENGOTO8000
  27. 129 IFI=80THENGOTO8000
  28. 130 GOTO50
  29. 135 L=INT(100*(S/(I-1)))
  30. 140 L=INT(100*(S/(I-1)))
  31. 145 PRINT:PRINT"AVG. WEEKLY LOSS  ";L/100;"LBS."
  32. 150 PRINT"LBS. TO GOAL  ";W1-G;"   GOAL =";G
  33. 160 PRINT"TOTAL POUNDS LOST SO FAR  ";S
  34. 165 PRINT"    PRESS ANY KEY TO CONTINUE"
  35. 167 GETA$:IFA$=""THENGOTO167
  36. 170 PRINT"[147]          WEIGHT WATCHER'S GRAPH":PRINT
  37. 175 REM-----STANDARD SCALE (110-170)----
  38. 180 A=110:B=170
  39. 190 GOSUB315
  40. 250 REM-----CUSTOMIZED SCALE----------
  41. 260 PRINT"     WANT A CUSTOMIZED GRAPH ? ";:GOSUB60000
  42. 270 IFLEFT$(IN$,1)<>"Y"THEN2000
  43. 280 PRINT"[147]WHAT IS THE SMALLEST NUMBER ? ";
  44. 290 GOSUB60000:A=VAL(IN$)
  45. 300 PRINT"WHAT IS THE LARGEST NUMBER ?  ";
  46. 301 GOSUB60000:B=VAL(IN$)
  47. 302 PRINT"[147]":IF(B-A)>60THENGOTO7000
  48. 303 IFB<=ATHENGOTO7500
  49. 304 PRINT:GOSUB315
  50. 305 PRINT"        WANT ANOTHER GRAPH ? ";:GOSUB60000
  51. 307 IFIN$="YES"THEN280
  52. 308 IFIN$="Y"THEN280
  53. 309 GOTO2000
  54. 315 REM-----GRAPH SUBROUTINE-----
  55. 316 X=0
  56. 317 REM-----HEADING (LINE 1)-----
  57. 320 IFB=0THENB=.00001
  58. 330 FORI=ATOBSTEP10
  59. 340 PRINTTAB(X*10*(30/(B-A))+5);I;
  60. 350 X=X+1
  61. 360 NEXTI
  62. 370 PRINT
  63. 375 REM-----HEADING (LINE 2)-----
  64. 376 PRINT"     [192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][145]"
  65. 380 PRINT"    [176]";
  66. 390 FORI=0TO(X-1)
  67. 400 PRINTTAB(I*30*(10/(B-A))+7);"[178]";
  68. 410 NEXTI
  69. 420 PRINT
  70. 425 RESTORE
  71. 426 READG
  72. 428 REM-----PRINT GRAPH-----
  73. 429 I=0
  74. 430 I=I+1
  75. 440 READW
  76. 450 IFW<0THEN480
  77. 454 IFW<ATHENPRINTI;TAB(4);"[171]";TAB(15)"OUT OF RANGE":GOTO465
  78. 455 IFW>BTHENPRINTI;TAB(4);"[171]";TAB(15)"OUT OF RANGE":GOTO465
  79. 460 PRINTI;TAB(4);"[171]";TAB((W-A)*(30/(B-A))+6);"*"
  80. 465 IFI=16GOTO8500
  81. 466 IFI=32GOTO8500
  82. 467 IFI=48GOTO8500
  83. 468 IFI=64GOTO8500
  84. 469 IFI=80GOTO8500
  85. 470 GOTO430
  86. 480 RETURN
  87. 996 REM********************************
  88. 997 REM     INSERT DATA HERE
  89. 998 REM
  90. 999 REM********************************
  91. 1000 DATA122,153,149.5,147.5,147.5,145,144.5,141,141.5,139.25
  92. 1010 DATA139.5,137.5,138.5,137,136.5,136,135,135,133,134,133,132,130,129,134
  93. 1020 DATA -1
  94. 1997 REM*******************************
  95. 1998 REM
  96. 2000 PRINT"[147]            KEEP DIETING"
  97. 2010 T=TI
  98. 2020 IFTI-T<180THEN2020
  99. 2030 PRINT"[147]":END
  100. 3000 PRINT"[147]     WANT DIRECTIONS ? ";:GOSUB60000
  101. 3010 IFLEFT$(IN$,1)<>"Y"THEN18
  102. 3020 PRINT"[147]WEIGHT WATCHER                  PAGE 1
  103. 3030 [153]"--------------------------------------"
  104. 3040 [153]"THIS PROGRAM ENABLES YOU TO KEEP TRACK"
  105. 3050 [153]"OF YOUR DIETING EFFORTS AND MAKE A "
  106. 3060 [153]"CHART OF YOUR PROGRESS (OR LACK OF"
  107. 3070 [153]"PROGRESS).  A SAMPLE DISPLAY IS IN-"
  108. 3080 [153]"CLUDED.  YOU CAN CUSTOMIZE THE CHART"
  109. 3090 [153]"SCALE TO EXPAND OR CONTRACT IT.  JUST "
  110. 3100 [153]"FOLLOW THE DIRECTIONS IN THE  PROGRAM."
  111. 3110 [153]"PUT THE RESULTS OF YOUR WEEKLY WEIGH-"
  112. 3120 [153]"IN AS PART OF THE DATA STATEMENTS"
  113. 3130 [153]"STARTING AT LINE 1000."
  114. 3135 [141]4000
  115. 3140 [153]"YOUR GOAL MUST BE THE FIRST DATA ENTRY "
  116. 3150 [153]"WITH -1 AS THE FINAL DATA ENTRY."
  117. 3160 [153]"GOOD LUCK IN REACHING YOUR GOAL."
  118. 3165 [153]"YOU LOOK THINNER ALREADY."
  119. 3170 [141]5000
  120. 3180 [142]
  121. 4000 [153]"---------------------------------------"
  122. 4010 [153]"      PRESS ANY KEY TO CONTINUE"
  123. 4020 [161]A$:[139]A$[178]""[167]4020
  124. 4030 [153]"LOADWEIGHT WATCHER                  PAGE 2
  125. 4040 PRINT"--------------------------------------"
  126. 4050 RETURN
  127. 5000 PRINT"---------------------------------------"
  128. 5010 PRINT"      PRESS ANY KEY TO BEGIN"
  129. 5020 GETA$:IFA$=""THEN5020
  130. 5030 RETURN
  131. 7000 PRINT"     THE MAXIMUM RANGE IS 60 POUNDS"
  132. 7010 FOR I=1TO1000:NEXTI
  133. 7020 GOTO260
  134. 7500 PRINT"          HOW'S THAT AGAIN ?"
  135. 7510 FORI=1TO1000:NEXTI
  136. 7520 GOTO260
  137. 8000 PRINT"      PRESS ANY KEY TO CONTINUE"
  138. 8010 GETA$:IFA$=""THEN8010
  139. 8012 PRINT"                                       "
  140. 8014 FORJ=1TO20
  141. 8015 PRINT"                                      "
  142. 8016 NEXTJ
  143. 8017 PRINT""
  144. 8020 GOTO50
  145. 8500 PRINT"      PRESS ANY KEY TO CONTINUE"
  146. 8510 GETA$:IFA$=""THEN8510
  147. 8512 PRINT"                                       "
  148. 8514 FORJ=1TO18
  149. 8515 PRINT"                                      "
  150. 8516 NEXTJ
  151. 8517 PRINT""
  152. 8520 GOTO430
  153. 60000 IN$=" ":ZT=TI:ZC=2:ZD$=CHR$(20)
  154. 60010 GETZ$:IF Z$<>""THEN60070
  155. 60020 IFZT<=TITHENPRINTMID$(" [166]",ZC,1);"[157]";:ZC=3-ZC:ZT=TI+15
  156. 60030 GOTO60010
  157. 60070 Z=ASC(Z$):ZL=LEN(IN$):IF(ZAND127)<32THENPRINT" [157]";:GOTO60110
  158. 60080 IFFLAND(ZAND127)>64AND(ZAND127)<91THENZ$=CHR$((Z+128)AND255)
  159. 60090 IFZL>254THEN60010
  160. 60100 IN$=IN$+Z$:PRINTZ$;ZD$;Z$;
  161. 60110 IFZ=13THENIN$=MID$(IN$,2):PRINTCR$;:RETURN
  162. 60120 IFZ=20ANDZL>1THENIN$=LEFT$(IN$,ZL-1):PRINT"[157]";:GOTO60010
  163. 60130 IFZ=141THENZ$=CHR$(-20*(ZL>1)):FORZ=2TOZL:PRINTZ$;:NEXTZ:GOTO60000
  164. 60140 GOTO60010
  165.